home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / src / tclXflock.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-19  |  8.5 KB  |  312 lines
  1. /*
  2.  * tclXflock.c
  3.  *
  4.  * Extended Tcl flock and funlock commands.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXflock.c,v 3.0 1993/11/19 06:59:38 markd Rel $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * Prototypes of internal functions.
  23.  */
  24. static int
  25. ParseLockUnlockArgs _ANSI_ARGS_((Tcl_Interp    *interp,
  26.                                  int            argc,
  27.                                  char         **argv,
  28.                                  int            argIdx,
  29.                                  OpenFile     **filePtrPtr,
  30.                                  struct flock  *lockInfoPtr));
  31.  
  32. /*
  33.  * If F_SETLKW is not defined, we assume file locking is not available.
  34.  */
  35. #ifdef F_SETLKW
  36.  
  37. /*
  38.  *-----------------------------------------------------------------------------
  39.  *
  40.  * ParseLockUnlockArgs --
  41.  *
  42.  * Parse the positional arguments common to both the flock and funlock
  43.  * commands:
  44.  *   ... fileId ?start? ?length? ?origin?
  45.  *
  46.  * Parameters:
  47.  *   o interp (I) - Pointer to the interpreter, errors returned in result.
  48.  *   o argc (I) - Count of arguments supplied to the comment.
  49.  *   o argv (I) - Commant argument vector.
  50.  *   o argIdx (I) - Index of the first common agument to parse.
  51.  *   o filePtrPtr (O) - Pointer to the open file structure returned here.
  52.  *   o lockInfoPtr (O) - Fcntl info structure, start, length and whence
  53.  *     are initialized by this routine.
  54.  * Returns:
  55.  *   TCL_OK if all is OK,  TCL_ERROR and an error message is result.
  56.  *
  57.  *-----------------------------------------------------------------------------
  58.  */
  59. static int
  60. ParseLockUnlockArgs (interp, argc, argv, argIdx, filePtrPtr, lockInfoPtr)
  61.     Tcl_Interp    *interp;
  62.     int            argc;
  63.     char         **argv;
  64.     int            argIdx;
  65.     OpenFile     **filePtrPtr;
  66.     struct flock  *lockInfoPtr;
  67. {
  68.  
  69.     lockInfoPtr->l_start  = 0;
  70.     lockInfoPtr->l_len    = 0;
  71.     lockInfoPtr->l_whence = 0;
  72.  
  73.     *filePtrPtr = Tcl_GetOpenFileStruct (interp, argv [argIdx]);
  74.     if (*filePtrPtr == NULL)
  75.     return TCL_ERROR;
  76.     argIdx++;
  77.  
  78.     if ((argIdx < argc) && (argv [argIdx][0] != '\0')) {
  79.         if (Tcl_GetLong (interp, argv [argIdx],
  80.                          &lockInfoPtr->l_start) != TCL_OK)
  81.             return TCL_ERROR;
  82.     }
  83.     argIdx++;
  84.  
  85.     if ((argIdx < argc) && (argv [argIdx][0] != '\0')) {
  86.         if (Tcl_GetLong (interp, argv [argIdx], &lockInfoPtr->l_len) != TCL_OK)
  87.             return TCL_ERROR;
  88.     }
  89.     argIdx++;
  90.  
  91.     if (argIdx < argc) {
  92.         if (STREQU (argv [argIdx], "start"))
  93.             lockInfoPtr->l_whence = 0;
  94.         else if (STREQU (argv [argIdx], "current"))
  95.             lockInfoPtr->l_whence = 1;
  96.         else if (STREQU (argv [argIdx], "end"))
  97.             lockInfoPtr->l_whence = 2;
  98.         else
  99.             goto badOrgin;
  100.     }
  101.  
  102.     return TCL_OK;
  103.  
  104.   badOrgin:
  105.     Tcl_AppendResult(interp, "bad origin \"", argv [argIdx],
  106.                      "\": should be \"start\", \"current\", or \"end\"",
  107.                      (char *) NULL);
  108.     return TCL_ERROR;
  109.    
  110. }
  111.  
  112. /*
  113.  *-----------------------------------------------------------------------------
  114.  *
  115.  * Tcl_FlockCmd --
  116.  *
  117.  * Implements the `flock' Tcl command:
  118.  *    flock ?-read|-write? ?-nowait? fileId ?start? ?length? ?origin?
  119.  *
  120.  * Results:
  121.  *      A standard Tcl result.
  122.  *
  123.  *-----------------------------------------------------------------------------
  124.  */
  125. int
  126. Tcl_FlockCmd (notUsed, interp, argc, argv)
  127.     ClientData   notUsed;
  128.     Tcl_Interp  *interp;
  129.     int          argc;
  130.     char       **argv;
  131. {
  132.     int           argIdx, stat;
  133.     int           readLock = FALSE, writeLock = FALSE, noWaitLock = FALSE;
  134.     OpenFile     *filePtr;
  135.     struct flock  lockInfo;
  136.  
  137.     if (argc < 2)
  138.         goto invalidArgs;
  139.  
  140.     /*
  141.      * Parse off the options.
  142.      */
  143.     
  144.     for (argIdx = 1; (argIdx < argc) && (argv [argIdx][0] == '-'); argIdx++) {
  145.         if (STREQU (argv [argIdx], "-read")) {
  146.             readLock = TRUE;
  147.             continue;
  148.         }
  149.         if (STREQU (argv [argIdx], "-write")) {
  150.             writeLock = TRUE;
  151.             continue;
  152.         }
  153.         if (STREQU (argv [argIdx], "-nowait")) {
  154.             noWaitLock = TRUE;
  155.             continue;
  156.         }
  157.         goto invalidOption;
  158.     }
  159.  
  160.     if (readLock && writeLock)
  161.         goto bothReadAndWrite;
  162.     if (!(readLock || writeLock))
  163.         writeLock = TRUE;
  164.  
  165.     /*
  166.      * Make sure there are enough arguments left and then parse the 
  167.      * positional ones.
  168.      */
  169.     if ((argIdx > argc - 1) || (argIdx < argc - 4))
  170.         goto invalidArgs;
  171.  
  172.     if (ParseLockUnlockArgs (interp, argc, argv, argIdx, &filePtr,
  173.                              &lockInfo) != TCL_OK)
  174.         return TCL_ERROR;
  175.  
  176.     if (readLock && ((filePtr->permissions & TCL_FILE_READABLE) == 0))
  177.         goto notReadable;
  178.     if (writeLock && ((filePtr->permissions & TCL_FILE_WRITABLE) == 0))
  179.         goto notWritable;
  180.  
  181.     lockInfo.l_type = writeLock ? F_WRLCK : F_RDLCK;
  182.     
  183.     stat = fcntl (fileno (filePtr->f), noWaitLock ? F_SETLK : F_SETLKW, 
  184.                   &lockInfo);
  185.  
  186.     /*
  187.      * Check to see if the lock failed due to it being locked or
  188.      * an error.
  189.      */
  190.     if ((stat < 0) && !((errno == EACCES) || (errno == EAGAIN))) {
  191.         interp->result = Tcl_PosixError (interp);
  192.         return TCL_ERROR;
  193.     }
  194.     
  195.     if (noWaitLock)
  196.         interp->result = (stat < 0) ? "0" : "1";
  197.  
  198.     return TCL_OK;
  199.  
  200.     /*
  201.      * Code to return error messages.
  202.      */
  203.  
  204.   invalidArgs:
  205.     Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " ?-read|-write? ",
  206.                       "?-nowait? fileId ?start? ?length? ?origin?",
  207.                       (char *) NULL);
  208.     return TCL_ERROR;
  209.  
  210.     /*
  211.      * Invalid option found at argv [argIdx].
  212.      */
  213.   invalidOption:
  214.     Tcl_AppendResult (interp, "invalid option \"", argv [argIdx],
  215.                       "\" expected one of \"-read\", \"-write\", or ",
  216.                       "\"-nowait\"", (char *) NULL);
  217.     return TCL_ERROR;
  218.  
  219.   bothReadAndWrite:
  220.     interp->result = "can not specify both \"-read\" and \"-write\"";
  221.     return TCL_ERROR;
  222.  
  223.   notReadable:
  224.     interp->result = "file not open for reading";
  225.     return TCL_ERROR;
  226.  
  227.   notWritable:
  228.     interp->result = "file not open for writing";
  229.     return TCL_ERROR;
  230. }
  231.  
  232. /*
  233.  *-----------------------------------------------------------------------------
  234.  *
  235.  * Tcl_FunlockCmd --
  236.  *
  237.  * Implements the `funlock' Tcl command:
  238.  *    funlock fileId ?start? ?length? ?origin?
  239.  *
  240.  * Results:
  241.  *      A standard Tcl result.
  242.  *
  243.  *-----------------------------------------------------------------------------
  244.  */
  245. int
  246. Tcl_FunlockCmd (notUsed, interp, argc, argv)
  247.     ClientData   notUsed;
  248.     Tcl_Interp  *interp;
  249.     int          argc;
  250.     char       **argv;
  251. {
  252.     OpenFile     *filePtr;
  253.     struct flock  lockInfo;
  254.  
  255.     if ((argc < 2) || (argc > 5))
  256.         goto invalidArgs;
  257.  
  258.     if (ParseLockUnlockArgs (interp, argc, argv, 1, &filePtr,
  259.                              &lockInfo) != TCL_OK)
  260.         return TCL_ERROR;
  261.  
  262.     lockInfo.l_type = F_UNLCK;
  263.     
  264.     if (fcntl (fileno(filePtr->f), F_SETLK, &lockInfo) < 0) {
  265.         interp->result = Tcl_PosixError (interp);
  266.         return TCL_ERROR;
  267.     }
  268.     
  269.     return TCL_OK;
  270.  
  271.   invalidArgs:
  272.     Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  273.                       " fileId ?start? ?length? ?origin?", (char *) NULL);
  274.     return TCL_ERROR;
  275.  
  276. }
  277. #else
  278.  
  279. /*
  280.  *-----------------------------------------------------------------------------
  281.  *
  282.  * Tcl_FlockCmd --
  283.  * Tcl_FunlockCmd --
  284.  *
  285.  * Versions of the command that always returns an error on systems that
  286.  * don't have file locking.
  287.  *
  288.  *-----------------------------------------------------------------------------
  289.  */
  290. int
  291. Tcl_FlockCmd (notUsed, interp, argc, argv)
  292.     ClientData   notUsed;
  293.     Tcl_Interp  *interp;
  294.     int          argc;
  295.     char       **argv;
  296. {
  297.     interp->result = "File locking is not available on this system";
  298.     return TCL_ERROR;
  299. }
  300.  
  301. int
  302. Tcl_FunlockCmd (notUsed, interp, argc, argv)
  303.     ClientData   notUsed;
  304.     Tcl_Interp  *interp;
  305.     int          argc;
  306.     char       **argv;
  307. {
  308.     return Tcl_FlockCmd (notUsed, interp, argc, argv);
  309. }
  310. #endif
  311.  
  312.